Reglas de Asociación


library(arules)
library(gridExtra)
library(arulesViz)
library(plyr)

Objetivo

El objetivo de esta sección es el de construir reglas de asociación mediante las cuáles poder obtener información de qué productos se compran juntos, es decir, si un cliente compra un producto determinado, es muy probable que también compre otro producto. Así, se pueden proponer sugerencias para la cadena de tiendas. Dichas sugerencias se presentan al final de esta sección.

Ejecución

Para obtener las reglas de asociación, trabajaremos con la tabla cl_prod, resultante de la unión de las tablas cliente y producto.

Seleccionamos las variables cod.cliente y descripcion para la aplicación de las reglas de asociación. Así, nos quedamos con los datos de qué clientes compran qué productos.

# dataframe con el que vamos a trabajar 

df_reglas_asociacion <- cl_prod %>% select(cod.cliente, descripcion) 


# volvemos a convertir cod.cliente en factor

df_reglas_asociacion$cod.cliente <- as.factor(df_reglas_asociacion$cod.cliente)

# adecuamos los levels

df_reglas_asociacion2 <- df_reglas_asociacion

levels(df_reglas_asociacion2$descripcion) <- str_trim(levels(df_reglas_asociacion2$descripcion))

Creamos una tabla de transacciones a partir del dataframe de partida:

transactionData  <- ddply(df_reglas_asociacion2, "cod.cliente", 
                          function(df_reglas_asociacion2)paste(df_reglas_asociacion2$descripcion,
                                                  collapse = ","))

#Eliminamos cod.cliente porque no se va a utilizar
transactionData$cod.cliente <- NULL


# cambiamos el nombre de la columna
names(transactionData) <- c("Productos")

Escribimos el resultado en un .csv y lo volvemos a leer desde R:

# # TRABAJO
# write.csv(transactionData,"C:/Users/rtrinchet/Desktop/gourmetdb/market_basket_transactions.csv", quote = FALSE, row.names = FALSE, fileEncoding = "UTF-8")
# 
# 
# tr <- read.transactions("C:/Users/rtrinchet/Desktop/gourmetdb/market_basket_transactions.csv", format = 'basket', sep=',', encoding = 'UTF-8')

# CASA



write.csv(transactionData,"C:/Users/rtyu_/Downloads/gourmetdb-20190102T170333Z-001/gourmetdb/market_basket_transactions.csv", quote = FALSE, row.names = FALSE, fileEncoding = "UTF-8")


tr <- read.transactions("C:/Users/rtyu_/Downloads/gourmetdb-20190102T170333Z-001/gourmetdb/market_basket_transactions.csv", format = 'basket', sep=',', encoding = 'UTF-8')

Se muestra un resumen de la matriz de transacciones:

summary(tr)
## transactions as itemMatrix in sparse format with
##  3924 rows (elements/itemsets/transactions) and
##  907 columns (items) and a density of 0.01633714 
## 
## most frequent items:
##      Tinto Reserva 95             Camembert Tinto Gran Reserva 91 
##                  1833                  1687                  1478 
##      Tinto Reserva 94           Bordeaux 97               (Other) 
##                  1465                  1385                 50297 
## 
## element (itemset/transaction) length distribution:
## sizes
##   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18 
##  91 135 162 147 189 181 196 212 203 206 171 172 155 139 116 132 113 107 
##  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36 
## 101  70  61  89  80  59  47  71  48  38  46  44  38  28  27  27  19  21 
##  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54 
##  15  19  13   8  10   8   9   5  11   4   4   4   4   2   2   6   9   5 
##  55  57  58  60  61  62  63  64  65  67  68  69  72  73  75  77  78  79 
##   5   2   2   1   5   5   1   2   3   4   1   1   1   1   3   2   1   1 
##  80  82  89  90 
##   1   1   1   1 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00    7.00   12.00   14.82   20.00   90.00 
## 
## includes extended item information - examples:
##                               labels
## 1                1989 Brut Champagne
## 2                          Abondance
## 3 Almendrados de las Monjas Clarisas

Los items con mayor número de ocurrencias se pueden observar en el siguiente gráfico:

itemFrequencyPlot(tr,topN=12,type="absolute", col="lightcyan2")

Elección de soporte y confianza

A continuación, tratamos de tomar una decisión sobre qué niveles de soporte y de confianza debemos utilizar. Para ello, mostramos una gráfica comparativa que presenta, para cada nivel de soporte, la evolución del número de reglas encontradas para cada nivel de confianza.

# Support and confidence values
supportLevels <- c(0.1, 0.05, 0.03, 0.01)
confidenceLevels <- c(0.9, 0.8, 0.7, 0.6, 0.5, 0.4, 0.3, 0.2, 0.1)

# Empty integers 
rules_sup10 <- integer(length=9)
rules_sup5 <- integer(length=9)
rules_sup3 <- integer(length=9)
rules_sup1 <- integer(length=9)

# maxima longitud
max_leng <- c(2)

# Apriori algorithm with a support level of 10%
for (i in 1:length(confidenceLevels)) {
  
  rules_sup10[i] <- length(apriori(tr, parameter=list(sup=supportLevels[1], 
                                                         conf=confidenceLevels[i], target="rules", maxlen=max_leng)))
  
}

# Apriori algorithm with a support level of 5%
for (i in 1:length(confidenceLevels)) {
  
  rules_sup5[i] <- length(apriori(tr, parameter=list(sup=supportLevels[2], 
                                                        conf=confidenceLevels[i], target="rules", maxlen=max_leng)))
  
}

# Apriori algorithm with a support level of 3%
for (i in 1:length(confidenceLevels)) {
  
  rules_sup3[i] <- length(apriori(tr, parameter=list(sup=supportLevels[3], 
                                                     conf=confidenceLevels[i], target="rules", maxlen=max_leng)))
  
}

# Apriori algorithm with a support level of 1%
for (i in 1:length(confidenceLevels)) {
  
  rules_sup1[i] <- length(apriori(tr, parameter=list(sup=supportLevels[4], 
                                                        conf=confidenceLevels[i], target="rules", maxlen=max_leng)))
  
}
# Number of rules found with a support level of 10%
plot1 <- qplot(confidenceLevels, rules_sup10, geom=c("point", "line"), 
               xlab="Confidence level", ylab="Number of rules found", 
               main="Apriori with a support level of 10%") +
  theme_bw()

# Number of rules found with a support level of 5%
plot2 <- qplot(confidenceLevels, rules_sup5, geom=c("point", "line"), 
               xlab="Confidence level", ylab="Number of rules found", 
               main="Apriori with a support level of 5%") + 
  scale_y_continuous() +
  theme_bw()



# Number of rules found with a support level of 3%
plot3 <- qplot(confidenceLevels, rules_sup3, geom=c("point", "line"), 
               xlab="Confidence level", ylab="Number of rules found", 
               main="Apriori with a support level of 3%") + 
  scale_y_continuous() +
  theme_bw()


# Number of rules found with a support level of 1%
plot4 <- qplot(confidenceLevels, rules_sup1, geom=c("point", "line"), 
               xlab="Confidence level", ylab="Number of rules found", 
               main="Apriori with a support level of 1%") + 
  scale_y_continuous() +
  theme_bw()


# Subplot
grid.arrange(plot1, plot2, plot3, plot4, ncol=2)

Interpretemos los resultados del gráfico:

  • Con un nivel de soporte del 10%. Identificamos unas pocas reglas con niveles de confianza, por lo general, inferiores al 50%. Las reglas con confianza mayor del 50% son unas 50. No escogeremos este nivel de soporte.

  • Con un nivel de soporte del 5%. Empezamos a ver más reglas con alto nivel de confianza: +200 con confianza mayor del 50%.

  • Con un nivel de soporte del 3%. Tenemos una gran cantidad de reglas para este nivel, lo que complica demasiado el análisis (unas 400 con confianza mayor al 50%). No escogeremos este nivel de soporte.

  • Con un nivel de soporte del 1%. Muchas más reglas que en el apartado anterior (ahora ya del orden de 1000 con confianza mayor al 50%). Tampoco escogeremos este nivel de soporte.

En definitiva, usaremos un soporte del 5%, puesto que se obtiene un buen número de reglas con un nivel de confianza superior al 60%, lo cual es más que suficiente para el análisis que se pretende realizar. Escogemos reglas con longitud máxima 2 para obtener reglas de negocio fácilmente interpretables (del estilo si el cliente compra A, entonces compra B).

# 5% support

### solo longitud 1 
association.rules <- apriori(tr, parameter = list(supp=0.05, conf=0.6,maxlen=2))
## Apriori
## 
## Parameter specification:
##  confidence minval smax arem  aval originalSupport maxtime support minlen
##         0.6    0.1    1 none FALSE            TRUE       5    0.05      1
##  maxlen target   ext
##       2  rules FALSE
## 
## Algorithmic control:
##  filter tree heap memopt load sort verbose
##     0.1 TRUE TRUE  FALSE TRUE    2    TRUE
## 
## Absolute minimum support count: 196 
## 
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[907 item(s), 3924 transaction(s)] done [0.02s].
## sorting and recoding items ... [71 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 done [0.00s].
## writing ... [55 rule(s)] done [0.00s].
## creating S4 object  ... done [0.00s].

Vemos las 10 reglas que tienen un mayor nivel de confianza:

summary(association.rules)
## set of 55 rules
## 
## rule length distribution (lhs + rhs):sizes
##  2 
## 55 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       2       2       2       2       2       2 
## 
## summary of quality measures:
##     support          confidence          lift           count       
##  Min.   :0.05046   Min.   :0.6004   Min.   :1.285   Min.   : 198.0  
##  1st Qu.:0.06205   1st Qu.:0.6066   1st Qu.:1.339   1st Qu.: 243.5  
##  Median :0.08002   Median :0.6257   Median :1.403   Median : 314.0  
##  Mean   :0.10273   Mean   :0.6323   Mean   :1.446   Mean   : 403.1  
##  3rd Qu.:0.13685   3rd Qu.:0.6506   3rd Qu.:1.463   3rd Qu.: 537.0  
##  Max.   :0.25841   Max.   :0.7084   Max.   :2.053   Max.   :1014.0  
## 
## mining info:
##  data ntransactions support confidence
##    tr          3924    0.05        0.6
## ordenamos por confidence y count (ante empate). Mostramos las 10 primeras reglas.
top.confidence <- sort(association.rules, by=c("confidence", "count"), decreasing=TRUE)

inspect(head(top.confidence, 10))
##      lhs                            rhs                                  support confidence     lift count
## [1]  {Mountain Gorgonzola}       => {Tinto Reserva 95}                0.07492355  0.7084337 1.516582   294
## [2]  {Scotch Whiskey 10 años}    => {Tinto Reserva 95}                0.13965341  0.6858573 1.468251   548
## [3]  {Queso de cabra}            => {Tinto Reserva 95}                0.05555556  0.6833856 1.462960   218
## [4]  {Blanc de Blancs Grand Cru} => {Brut Chardonnay Blanc de Blancs} 0.05045872  0.6804124 2.042799   198
## [5]  {Mature Cheddar}            => {Tinto Reserva 95}                0.13506626  0.6803594 1.456481   530
## [6]  {Chenin Blanc 97}           => {Tinto Reserva 95}                0.05886850  0.6794118 1.454453   231
## [7]  {Swiss Emmental}            => {Tinto Reserva 95}                0.08537207  0.6767677 1.448792   335
## [8]  {Roquefort}                 => {Tinto Reserva 95}                0.13863405  0.6716049 1.437740   544
## [9]  {Layden Gin}                => {Tinto Reserva 95}                0.08409786  0.6680162 1.430058   330
## [10] {Chablis Chardonnay 97/98}  => {Tinto Reserva 95}                0.13200815  0.6649551 1.423504   518

Conocimiento extraído: el 70 % de los que compran el queso Mountain Gorgonzola también compran el vino Tinto Reserva 95. Esto ocurre en el 7% del conjunto de los clientes del negocio, lo que se corresponde con 294 clientes.

Si ordenamos las reglas por count, es decir, por el número de clientes para las que se producen, obtenemos el siguiente resultado:

## ordenamos por confidence y count ante empate. Mostramos las 10 primeras reglas.
top.confidence <- sort(association.rules, by=c( "count"), decreasing=TRUE)

inspect(head(top.confidence, 10))
##      lhs                            rhs                 support  
## [1]  {Camembert}                 => {Tinto Reserva 95}  0.2584098
## [2]  {Tinto Gran Reserva 91}     => {Tinto Reserva 95}  0.2280836
## [3]  {Bordeaux 97}               => {Tinto Reserva 95}  0.2127931
## [4]  {Manchego}                  => {Tinto Reserva 95}  0.2107543
## [5]  {Merlot 97}                 => {Tinto Reserva 95}  0.1967380
## [6]  {Parmigiano Reggiano}       => {Tinto Reserva 95}  0.1954638
## [7]  {Tiramisú}                  => {Chocolate Truffle} 0.1786442
## [8]  {Chocolate Truffle}         => {Tiramisú}          0.1786442
## [9]  {Scotch Whiskey 18 años}    => {Tinto Reserva 95}  0.1577472
## [10] {Dark Chocolate Digestives} => {Tinto Reserva 95}  0.1557085
##      confidence lift     count
## [1]  0.6010670  1.286736 1014 
## [2]  0.6055480  1.296329  895 
## [3]  0.6028881  1.290634  835 
## [4]  0.6148699  1.316284  827 
## [5]  0.6026542  1.290134  772 
## [6]  0.6092137  1.304176  767 
## [7]  0.6074523  2.053095  701 
## [8]  0.6037898  2.053095  701 
## [9]  0.6441207  1.378903  619 
## [10] 0.6241062  1.336057  611

Descubrimos las reglas que involucran la trufa de chocolate y el tiramisú: más del 60% de los clientes que compran trufas de chocolate, también compran tiramisú, y viceversa.

Visualización de las reglas

En este apartado, se presentan algunas visualizaciones de las reglas construídas.

En primer lugar, visualizamos las 55 reglas de asociación que hemos obtenido. Se muestran los valores de confianza, lift y soporte.

plot(association.rules)

Se presenta una visualización similar pero con la que se puede interactuar y saber qué productos representa cada regla. Esta visualización podría ser interesante para mostrar al cliente.

# vis. interactiva: https://journal.r-project.org/archive/2017/RJ-2017-047/RJ-2017-047.pdf 
plot(association.rules, engine = "htmlwidget")

Por último, se incluye una visualización en grafo para las 12 reglas con mayor nivel de confianza. De este modo, podemos observar los productos que desembocan en la compra de tinto reserva 95 junto con la cantidad de veces que ocurre la coincidencia.

subrules1 <- head(association.rules, n = 12, by = "confidence")
plot(subrules1, method = "graph")

Sugerencias para el negocio

En primer lugar, observamos diversas reglas que involucran al vino Tinto Reserva 95. Dichas reglas indican que gran cantidad de clientes que compran algún otro producto, también compran el mencionado vino. De entre dichas reglas, convendría destacar aquellas en las que el miembro izquierdo es un producto que no sea alcoholico (por ejemplo, Mountain Gorgonzola o Queso de Cabra). Una posible sugerencia sería colocar en las tiendas los productos no alcoholicos que aparecen en el miembro izquierdo de las 10 reglas que están ordenadas por nivel de confianza, junto al Tinto Reserva 95, en particular, y junto a la sección de vinos, en general.

Otra posibilidad sería ofrecer algún tipo de incentivo a los clientes que compren juntas ambas cosas: acumular más puntos, la creación de jornadas gastronómicas que junten vino y queso, entre otras.

En segundo lugar, observamos que las trufas de chocolate y el tiramisú son comprados juntos con una elevada frecuencia. Por tanto, se podrían recomendar medidas similares para dichos productos.